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1.  Introduction 

The  GT-VFPU  test  board  was  developed  to  characterize  the  operating  speed  of  the  GT- 
VFPU  chip.  This  document  presents  the  design  of  the  test  board,  the  testing  strategy,  and  the  test 
results. 

2.  Board  Design 

The  architecture  of  the  GT-VFPU  test  board  is  shown  in  Figure  1 .  The  board  was  designed 
on  a  Multibus  I  board.  A  Multibus  I  to  PC-AT  interface  board  is  used  to  connect  the  test  board 
to  a  PC-AT  host.  The  clock  that  drives  the  GT-VFPU  chip  is  connected  externally  to  a  function 
generator.  The  power  to  the  GT-VFPU  chip  is  decoupled  from  the  Multibus  power  plane.  It  is 
connected  to  an  external  power  supply. 

The  test  software  running  on  the  PC  Host  generates  a  set  of  test  vectors  for  each  opcode 
category  and  downloads  them  into  the  memory  unit  that  stores  the  stimuli  for  the  GT-VFPU.  Once 
instructed  to  execute,  a  run-time  controller  fetches  the  stimuli  sequentially  from  each  of  the 
memory  locations.  For  each  stimuli,  GT-VFPU  computes  the  result  and  stores  it  in  a  second 
memory  unit.  The  test  software  on  the  PC  computes  the  correct  results  to  be  expected  and  com¬ 
pares  this  result  with  the  result  generated  by  the  GT-VFPU.  The  memory  units  are  capable  of 
generating  and  capturing  4096  vectors  in  a  single  run. 

The  test  board  schematic  design  is  included  in  Appendix  A.  The  source  programs  for  the 
on-board  GALs  are  listed  in  Appendix  B.  The  source  code  listing  of  the  test  software  is  listed  in 
Appendix  C. 

3.  Test  Monitor 

A  test  monitor  running  on  the  PC-AT  host  was  developed  to  control  the  GT-VFPU  test 
board.  It  consists  of  1,530  lines  of  Turbo  Pascal  source  code.  The  available  commands  are: 

tmem  :  test  memory; 

tlog  :  test  xor/and/or/passR/not  R/not  S; 

tiadd  :  test  integer  add/sub/rsub; 

timult :  test  integer  mult 

tfadd  :  test  floating  point  add 
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Figure  1.  GT-YFPU  Test  Board  Architecture 

tfmult :  test  floating  point  mult 
tshift :  test  ROR/ROL/SHR/SHL 
tspecO  :  test  pack  exp  &  float 

tspecl  :  test  seed,  unp_exp,  unp_man,  root_exp,  &  root_man 

tspec2  :  test  round  &  trunc 

tspec3  :  test  sign  manipulation 

tall  :  test  all  of  the  above 

dsoe  :  do  not  stop  on  error 

soe  :  stop  on  error 

start  :  start  testing 

stop  :  stop  testing 

sb  :  select  memory  bank 
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dw  :  display  memory  word 
sw  :  substitute  memory  word 
cont  :  set  testing  mode  to  continuous 
single  :  set  testing  mode  to  single 
debug  :  toggle  debug  setting 
quit  :  quit  FPU  Test  Monitor. 

Each  of  the  above  commands  can  be  invoked  from  the  monitor. 

4.  Test  Strategy 

The  GT-VFPU  opcodes  are  divided  into  five  broad  categories:  logical,  shift,  fixed-point, 
floating-point,  and  special.  The  stimuli  for  the  GT-VFPU  consists  of  the  signals  R[31..0], 
S  [3 1 :0] ,  and  Opcode[4:0] .  Two  vector  sets  were  used  to  provide  a  combination  of  stimuli  for  each 
opcode  category. 

The  first  set  consists  of  test  vectors  generated  from  a  fixed  set  of  patterns  devised  for  each 
opcode  category.  Three  arrays  are  used  to  store  the  primary  test  patterns  for  R[3 1 :0] ,  S  [3 1 :0] ,  and 
Opcode[4:0].  Three,  three-level-nested  loops  are  used  to  generate  the  test  patterns  for  different 
combinations  of  R[31:0],  S[31:0].-*md  Opcode[4:0].  Each  nested  loop  places  the  index  of  the 
R[3 1:0],  S[31 :0],  and  Opcode[4:0]  arrays  in  the  inner  loop.  The  purpose  is  to  generate  a  sequential 
set  of  patterns  that  toggle  the  different  sources  of  input  stimuli  to  the  GT-VFPU  on  a  per  cycle  ba¬ 
sis.  To  insure  that  the  opcode  bit  fields  are  toggling  every  cycle,  each  odd  storage  element  for  the 
Opcode[4:0]  array  is  stored  with  an  inverted  value  of  the  opcode  of  the  proceeding  even  storage 
element. 

The  second  vector  set  consists  of  random  patterns  for  R[31:0]  and  S[31:0]. 

The  fixed  patterns  for  each  opcode  categories  are  given  in  the  following  sections. 

4.1.  Logical  Operations 

The  logical  operations  are  passR,  and,  or,  xor,  not  R,  and  not  S.  The  fixed  patterns  used 
for  this  test  for  the  R[31:0]  and  S[31:0]  arrays  are  $00000000,  $ffffffff,  $555555555,  $aaaaaaaa, 
$fffffffff,  $000000000,  $12345678,  and  $9abcdef0.  The  pattern  $00000000  is  repeated  twice  to 
create  $ffffffff  to  $00000000  and  $00000000  to  $ffffffff  transitions. 

4.2.  Shift  Operations 

The  shift  operations  are  shift  left,  shift  right,  rotate  left,  and  rotate  right.  The  fixed  patterns 
used  for  this  test  for  the  R[3 1 :0]  array  are  $00000000,  $ffffffff,  $555555555,  $aaaaaaaa,  $fffffffff, 
$000000000,  $12345678,  and  $9abcdef0.  The  fixed  patterns  for  the  S[31:0]  array  are  $00000000, 
$00000001,  $00000010, ...,  $0000000f. 
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4.3.  Fixed-point  Operations 

The  fixed-point  operations  are  addition,  subtraction,  reverse  subtraction  (— R[3 1 :0]  + 
S[31:0]),  and  multiplication.  The  Multiplication  is  tested  separately. 

4.3.1.  Addition/Subtraction/Reverse  Substruction 

The  fixed  patterns  used  for  this  test  for  the  R[31:0]  and  S[31:0]  arrays  are  $00000000, 
$00ffffff,  $005555555,  $00aaaaaa,  $00fffffff,  $000000001,  $00123456,  $00abcdef,  $80ffffff, 
$805555555,  $80aaaaaa,  $80fffffff,  $800000001,  $80123456,  and  $80abcdef. 

4.32.  Multiplication 

The  fixed  patterns  used  for  this  test  for  the  R[31:0]  and  S[31:0]  arrays  are  $000000000, 
$00ffffff,  $00aaaaaa,  $00555555,  $00000fff,  $00000aaa,  $00000555,  $00ffffff,  $80000000, 
$80ffffff,  $80aaaaaa,  $80555555,  $80000fff,  $80000aaa,  $80000555,  $80ffffff. 

4.4.  Floating-Point  Operations 

The  floating-point  operations  are  addition,  subtraction,  reverse  subtraction,  and  multipli¬ 
cation.  The  multiplication  is  tested  separately. 

4.4.1.  AdditionISubtractionIReverse  Subtraction 

The  fixed  patterns  used  for  this  test  for  the  R[31:0]  and  S[31:0]  arrays  are  $3f000000, 
$3fffffff,  $3faaaaaa,  $3f555555,  $3f000001,  $7f000000,  $2a800000,  $55000000,  $00800000, 
$bf000000,  $bfffffff,  $bfaaaaaa,  $bf555555,  $bf00001,  $ff000000,  $aa800000,  $d5000000, 
$80800000. 

4.42.  Multiplication 

The  fixed  patterns  used  for  this  test  for  the  R[31:0]  and  S  [3 1 :0]  arrays  are  $00000000, 
$3fffffff,  $3faaaaaa,  $3f555555,  $00000fff,  $00000aaa,  $7f000555,  $7fffffff,  $08000000, 
$bfffffff,  $bfaaaaaa,  $bf555555,  $80000fff,  $80000aaa,  $ff000555,  $ffffffff. 

4.5.  Special  Operations 

The  special  operations  are  pack  exponent,  float,  inverse  seed,  unpack  exponent,  unpack 
mantissa,  square  root  exponent  seed,  square  root  mantissa  seed,  round,  trunc,  sign  of  sine,  odd  to 
negative,  change  sign,  and  sign  of  tan.  The  testing  of  these  operations  are  separated  into  four 
groups. 

45.1.  Pack  exponent! Float 

The  fixed  patterns  used  for  this  test  for  the  R[31:0]  and  S[31:0]  arrays  are  $00ffffff, 
$80000001,  $80000004,  $80000010,  $80000040,  $80000100,  $80ffffff. 
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452.  Inverse  Seed 1  Unpack  Exponent I  Unpack  Mantissa!  Square  Root  Seed 

The  fixed  patterns  used  for  this  test  for  the  R[31:0]  and  S[31:0]  arrays  are  $00000000, 
$3fffffff,  $00000fff,  $3f000555,  $08000000,  $bfffffff,  $80000fff,  $fF000555. 

453.  RoundlTrunc 

The  fixed  patterns  used  for  this  test  for  the  R[31:0]  and  S[31:0]  arrays  are  $00000000, 
$3fffffff,  $00000fff,  $3f000555,  $4b000000,  $bfffffff,  $c6000fff,  $bf000555. 

45.4.  Sign  of  Sine!  Odd  to  NegativelChange  Sign!  Sign  of  Tan 

The  fixed  patterns  used  for  this  test  for  the  R[3 1:0]  and  S[31:0]  arrays  are  $00000000, 
$00000001,  $80000010,  $80000001,  $3f800000,  $3f800001,  $bf800010,  and  $bf800001. 

5.  Test  Result 

All  Tests  were  done  at  room  temperature  (~75  deg  F).  Three  voltage  test  conditions  were 
applied  to  the  GT-VFPU  chip.  The  test  results  are  shown  in  Table  1. 


Table  1.  Maximum  Operating  Frequency  Characterized  by  Opcode  Category 


Opcode  Category 

4.5  V  @  150  mA 

5.0  V  @190  mA 

5.5  V  @  230  mA 

logical 

19 

19 

19 

Fixed-Point  Add 

18 

19 

19 

Fixed-Point  Mult 

19 

19 

19 

Floating-Point  Add 

16 

18 

18 

Floating-Point  Mult 

17 

19 

18 

Shift 

19 

19 

18 

Special  0 

17 

18 

18 

Special  1 

17 

18 

19 

Special  2 

15 

17 

19 

Special  3 

19 

19 

19 

Max/Min 

19/15 

19/17 

19/18 

6.  Conclusion 

The  GT-VFPU  test  board  demonstrated  that  the  Genesil  timing  and  power  analysis  were 
very  conservative.  Genesil  predicted  a  maximum  operating  frequency  of  6.6  Mhz  and  a  power  con¬ 
sumption  of  5.1  W  for  the  GT-VFPU  chips.  The  test  result  shows  that  the  GT-VFPU  operates  at 
17  Mhz  and  consumes  only  950  mW  with  a  5.0  V  supply.  The  highest  operating  frequency  attained 
is  19  Mhz.  This  limit  may  have  been  imposed  by  the  test  board. 
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Appendix  A 
Board  Schematics 
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Appendix  B 
GAL  Listing 
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NAME 

Partno 

Data 

Revision 

Designer 

Company 

Assembly 

Location 

Device 


Runctrl; 

000; 

08/30/90; 

0.0; 

Dr.  Tan; 

Cerl; 

FPU  test  board; 
Pal4; 

C16V8; 


/*  Input  */ 

Pin  1  =  clk_src;  /*  osc  */ 

Pin  2  =  osc; 

Pin  3  *  ! MWTC; 

Pin  4  =  ! ADR__1 6 ; 

Pin  5  =  BD_0; 

Pin  6  -  IBS; 


/*  Output  */ 

Pin  12  =  IweO; 

Pin  13  -  elk; 

Pin  14  =  osc_l; 

Pin  15  =  run; 

Pin  16  -  n_run; 

Pin  17  *  osc_2; 

Pin  18  =  clkl; 

Pin  19  =  Iwel; 

/*  Logic  Equations  */ 


run .d  =  (BS  &  MWTC  &  ADR_16  &  BD_0)  #  {{IBS  #  IMWTC  #  !ADR_16)  &  run) 

weO  =  MWTC  &  I  run; 

wel  =  (MWTC  &  Irun)  #  {(lose)  &  run  ); 

osc_l  =  osc; 

osc_2  =  osc_l; 

n_run  ■  Irun; 

elk  -  osc_l; 

clkl  =  osc_l; 


NAME 

Partno 

Date 

Revision 

Designer 

Company 

Assembly 

Location 

Device 


Csctrl; 

000; 

08/30/90; 

0.0; 

Dr.  Tan; 

Cerl; 

FPU  test  board; 
Pall; 

G16V8;  /*  EP310  */ 


/*  Inputs  */ 


Pin 

1 

=  ! ADR  13 

Pin 

2 

=  I ADR  14 

Pin 

3 

=  ! ADR  15 

Pin 

4 

«  ! ADR  16 

Pin 

5 

=  clkl; 

Pin 

6 

=  IBS; 

Pin 

7 

*  run; 

/*  Outputs  */ 

Pin 

12 

=  ICS  0; 

Pin 

13 

=  ICS  1; 

Pin 

14 

=  ICS  2; 

Pin 

15 

=  ICS  3; 

Pin 

16 

-  ICS  4; 

Pin 

17 

=  ICS  5; 

Pin 

18 

*  ICS  6; 

Pin 

19 

-  ICS  7; 

14 


/*  Logic  Equations  */ 


cs 

7 

= 

BS 

£ 

!  ADR 

16 

£ 

ADR 

15 

& 

ADR 

14 

£ 

ADR 

13 

£ 

!  run 

# 

run; 

cs" 

"6 

= 

BS 

£ 

!  ADR~ 

"16 

£ 

ADR" 

"15 

£ 

adr" 

"14 

£ 

!  ADR- 

'13 

£ 

!  run 

# 

run; 

cs" 

'5 

= 

BS 

& 

!ADR_ 

16 

£ 

ADR- 

"15 

£ 

!ADR- 

14 

£ 

adr" 

'13 

£ 

!  run 

# 

run; 

cs' 

"4 

s 

BS 

& 

!  ADR~ 

"16 

£ 

ADR- 

15 

£ 

!  ADR- 

'14 

£ 

!  ADR- 

13 

£ 

!  run 

# 

run; 

cs" 

‘3 

* 

BS 

& 

!  ADR" 

~16 

& 

iadr" 

"15 

£ 

adr" 

‘14 

£ 

adr" 

"13 

£ 

!  run 

# 

run; 

cs" 

"2 

= 

BS 

& 

!  ADR- 

16 

& 

!ADR- 

15 

£ 

ADR- 

'14 

£ 

!  ADR- 

13 

£ 

!run 

# 

run; 

cs' 

’l 

BS 

£ 

!  ADR 

~16 

& 

!  ADR- 

"15 

£ 

!  ADR~ 

“l4 

£ 

ADR- 

'13 

£ 

!  run 

# 

run; 

cs" 

"0 

= 

BS 

£ 

!  ADR~ 

"16 

£ 

!  ADR~ 

‘15 

£ 

!  ADR- 

'14 

£ 

!  ADR** 

‘13 

£ 

!  run 

# 

run; 

15 


Naina  Count  arl; 

Partno  000; 

Data  08/30/90; 

Ravi* ion  0.0; 

Designer  Dr.  Tan; 
Company  Carl; 

Assembly  FPU  tast  board; 
Location  Pal 6; 

Davica  G16V8; 

/*  Inputs  */ 

Pin  1  =  elk; 

Pin  2  =  cout; 

Pin  3  =  run; 

/*  Output  */ 

Pin  12  =  coutO; 

Pin  13  =  pc_0; 

Pin  14  =  pc_l; 

Pin  15  -  pc_2; 

Pin  16  =  pc_3; 

Pin  17  =  pc_4; 

Pin  18  =  pc_5; 


/*  Logic  Equations  */ 


pc_0 .d 

= 

( ! pc_0 

# 

cout) 

£  run 

/* 

original : 

cout 1  */ 

pc_l .  d 

= 

(  pc__0 

£ 

!pc_l 

# 

!  pc_ 

0  £  pc 

1 

#  cout) 

£  run; 

pc  2  .d 

= 

(  pc_0 

£ 

pc_l 

& 

!pc_2 

'  #  !  (pc_0~ 

£ 

pc_l) 

£ 

pc_2 

# 

cout)  £  run; 

pc  3  .d 

= 

(  pc  0 

£ 

pc_l 

£ 

pc_2 

£  ! pc_3 

# 

!  (pej) 

& 

pc_l 

£ 

pc_2) 

£  pc_3 

# 

cout) 

£ 

run; 

pc  4  .d 

= 

(  pc_0 

& 

p^_l 

£ 

pc_2 

£  pc_3 

£ 

!  pc_4 

# 

!  (pc_0 

£ 

pc_l 

£ 

pc_2 

£  pc_3) 

£ 

pc_4 

# 

cout ) 

£ 

run; 

pc_5 .  d 

= 

(  pc__0 

& 

pc_l 

£ 

pc_2 

£  pc_3 

£ 

pc_4 

£ 

!pc_5 

# 

!  (pc_0 

& 

pc_l 

£ 

pc_2 

£  pc_3 

£ 

pc_4) 

£ 

pc_5 

# 

cout)  £  run; 

coutO 

= 

pc_0 

& 

pc  1 

£  pc_ 

2  £  pc_ 

3 

£  pc_ 

4 

£  pc_5 

; 

Name  Counter2; 

Partno  000; 

Date  09/30/90; 

Revision  0.0; 

Designer  Dr.  Tan; 

Company  Cerl; 

Assembly  FPU  test  board; 

Location  PALS; 

Device  G16V8; 

/*  Input  */ 

Pin  1  =  elk; 

Pin  2  =  coutO; 

Pin  3  =  run; 

/*  Output  */ 

Pin  12  -  cout; 

Pin  13  =  pc_6; 

Pin  14  =  pc_7 ; 

Pin  15  =  pc_8; 

Pin  16  =  pc_9; 

Pin  17  =  pc_10; 

Pin  18  =  pc_ll; 

/*  Logic  Equations  */ 

pc_6.d  =  (coutO  £  !pc_6  #  ! coutO  &  pc_6  #  cout)  £  run; 

pc_7.d  =  (coutO  £  pc_6  &  !pc_7  #  ! (coutO  £  pc_6)  £  pc_7  #  cout)  £  run; 

pc_8.d  =  (coutO  £  pc_7  &  pc_6  &  !pc_8  # 

! (coutO  £  pc_7  &  pc_6)  &  pc_8  #  cout)  &  run; 
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pc_9 .d  = 

(coutO 

& 

pc_8 

& 

Pc_7 

& 

pc_6 

& 

!pc_9 

# 

! (coutO 

& 

pc_8 

& 

pc_7 

£ 

pc_6) 

£ 

pc_9 

# 

cout) 

& 

run; 

pc_l 0 . d  - 

{coutO 

& 

pc_9 

& 

pc_8 

& 

pc_7 

£ 

pc_6 

£ 

! pc_l 0 

# 

! (coutO 

& 

pc_9 

£ 

pc_8 

& 

pc_7 

£ 

pc_6) 

£ 

pc_10 

# 

cout) 

& 

run; 

pc_ll .d  = 

(coutO 

& 

pc_10 

£ 

pc_9 

£ 

pc_8 

£ 

p  c_7 

£ 

pc_6 

& 

!pc_ll 

# 

! (coutO 

& 

pc_10 

£ 

pc_9 

& 

pc_8 

£ 

pc_7 

£ 

pc_6) 

£ 

pcJLl 

# 

cout)  £ 

run; 

cout  = 

coutO 

& 

pc_ll 

£ 

pc_10 

£ 

pc_9 

£ 

pc_8 

£ 

pc_7 

&  ] 

pc_6; 
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NAME  Bectrl; 

Part no  000; 

Date  08/30/90; 

Revision  0.0; 

Designer  Dr.  Tan; 
Company  Cerl; 

Assembly  FPU  test  board; 
Location  Pal2; 

Device  G16V8; 

/*  Input  */ 

Pin  1  =  ! ADR_13 ; 

Pin  2  =  !ADR_14; 

Pin  3  =  !ADR_15; 

Pin  4  -  ! ADR_16; 

Pin  5  =  clkl; 

Pin  6  =  !BS; 

Pin  7  =  run; 

/*  Output  */ 

Pin  12  =  !Be_0; 

Pin  13  =  !Be_l; 

Pin  14  =  ! Be_2 ; 

Pin  15  =  !Be_3 ; 

Pin  16  =  !Be_4; 

Pin  17  -  !Be_5; 

Pin  18  =  !Be_6; 

Pin  19  -  !Be  7; 


/*  Logic  Equations  */ 


Be 

7 

= 

BS 

& 

!  ADR 

16 

& 

ADR 

15 

& 

!  ADR_ 

14 

& 

ADR 

13 

& 

!  run; 

Be" 

"6 

= 

BS 

& 

!  ADR~ 

'16 

& 

adr" 

"15 

& 

adr" 

14 

& 

!  ADR~ 

"13 

& 

!  run; 

Be" 

"5 

= 

BS 

& 

!  ADR" 

"16 

& 

ADR~ 

"15 

& 

adr“ 

14 

& 

adr" 

"13 

& 

!  run  ; 

Be 

"4 

* 

BS 

& 

!ADR_ 

"16 

& 

!  ADR~ 

"15 

& 

ADR~ 

14 

& 

!  ADR~ 

13 

& 

!  run; 

Be_ 

‘3 

= 

BS 

& 

!ADR~ 

16 

& 

!  ADR" 

15 

& 

ADR~ 

14 

& 

adr" 

"13 

& 

I  run; 

Be 

"2 

= 

BS 

& 

!  ADR" 

'16 

& 

!  ADR" 

"15 

& 

!  ADR~ 

14 

& 

!  ADR" 

"13 

& 

!run; 

Be" 

"l 

= 

BS 

& 

!  ADR~ 

"l6 

& 

!ADR“ 

"is 

& 

!  ADR" 

14 

& 

ADR 

"13 

& 

!  run; 

Be" 

"o 

= 

BS 

& 

!  ADR" 

"16 

& 

adr" 

"15 

& 

!  ADR* 

"l4 

& 

!  ADR 

"13 

& 

!  run; 
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NAME  Mbctrl; 

Part no  000; 

Date  08/30/90; 

Ravi sion  0.0; 

Da signor  Dr.  Tan; 

Company  Carl; 

Assembly  FPU  test  board; 

Location  Pal3; 

Davica  G16V8; 

/*  Input  */ 

Pin  1  =  osc; 

Pin  2  -  !MWTC; 

Pin  3  =  ! MRDC; 

Pin  4  -  !ADR_16; 

Pin  5  =  IADR_17; 

Pin  6  =  ! ADR_18; 

Pin  7  -  !ADR_19; 

/*  Output  */ 

Pin  12  =  MBdir; 

Pin  13  *  IXack; 

Pin  14  =  Xackl; 

Pin  15  =  XackO; 

Pin  17  -  MBdirl; 

Pin  18  -  IBS; 

Pin  19  =  iMBen; 

/*  Logic  Equations  */ 

XackO. D  =  !Xack  &  Xackl  &  (MWTC  #  MRDC); 

Xackl. D  =  IXack  &  IXackO  &  {MWTC  #  MRDC)  # 

Xackl  &  XackO  &  (MWTC  #  MRDC) ; 


/*  if  BS 

*/ 

Xack.OE  * 

BS; 

Xack.D  = 

(Xackl 

& 

XackO  & 

(MWTC 

# 

MRDC)  # 

Xack 

& 

IXackO  & 

(MWTC 

# 

MRDC) )  ; 

MBen  - 

MWTC  # 

MRDC; 

MBdir  = 

MWTC; 

MBdirl  = 

MWTC; 

BS 

!  ADR  19 

& 

I  ADR  18  & 

I  ADR 

17; 
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NAME  Runet rl; 

Partno  000; 

Data  08/30/90; 

Ravialon  0.0; 

Daaigner  Dr.  Tan; 

Company  Carl; 

Aaaambly  FPU  taat  board; 

Location  Pal4; 

Davica  C16V8; 

/*  Input  */ 

Pin  1  =  clk_src;  /*  osc  */ 

Pin  2  =  osc; 

Pin  3  =  ! MWTC ; 

Pin  4  =  !ADR_16; 

Pin  5  =  BD_0; 

Pin  6  =  IBS; 

/*  Output  */ 

Pin  12  =  IweO; 

Pin  13  -  elk; 

Pin  14  =  osc_l; 

Pin  15  =  run; 

Pin  16  =  n_run; 

Pin  17  =  osc_2; 

Pin  18  =  clkl; 

Pin  19  =  Iwel; 

/*  Logic  Equations  */ 

run .d  -  (BS  &  MWTC  6  ADR_16  &  BD_0)  #  ({IBS  #  IMWTC  #  !ADR_16)  &  run); 

weO  =  MWTC  &  irun; 

wel  =  (MWTC  &  Irun)  #  ((lose)  &  run  ); 

osc_l  =  osc; 

osc_2  «  osc_l; 

n__run  =  Irun; 

elk  =  osc_l; 

clkl  «  osc  1; 
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Appendix  C 

Test  Monitor  Source  Code 
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program  testfpu; 
uses  ieee_cnv, 

{$u  e:\dp\dp_comp\hex_conv} 
io, dos; 


const 

max_test_vector  =  4092; 
{  logical  } 
fpu_and  =  $8; 
fpu_or  =  $9; 
fpu_xor  =  $a; 
fpu_notR  =  $b; 
fpu_notS  *=•  $c; 
fpu_passR  =  $14; 

{  fixed  } 
fpu_add  -  $0; 
fpu_sub  =  $1; 
fpu_mult  =  $2; 
fpu_rsub  =  $3; 

{  float  } 
fpu__fadd  =  $10; 
fpu_fsub  =  $11; 
fpu_fmult  =  $12; 
fpu_frsub  =  $13; 

{  shift  } 
fpu_ror  *  $4; 
fpu_rol  =  $5; 
fpu_shr  =  $6; 
fpu_shl  =  $7; 

{  special  } 
fpu_pack  =  $0d; 
fpu_float  =  $15; 
fpu_seed  -  $e; 
fpu_unp_exp  =  $18; 
fpu_unp_man  =  $19; 
fpu_rootexp  =  $la; 
fpu_rootman  -  $lb; 
fpu_round  =  $f; 
fpu_int_r  =  $16; 
fpu_int_s  =  $17; 
fpu_sin_sgn  =  $lc; 
fpu_odd_neg  =  $ld; 
fpu_chg_sgn  =  $le; 
fpu_tan_sgn  =  $lf; 


hex_conv. 


{  test  cases  } 
logical  =0; 
iadd  =  1; 
imult  =2; 
fadd  =  3; 
fmult  »  4; 
shift  =  5; 
special  =  6; 


var  bank, of f set , i, address  :  word; 
start_bank,  end_bank  :  word; 
pattern  :  array[0..20]  of  word; 
ch  :  char; 
command  :  string; 
debug  :  boolean; 
rsign  :  integer; 
ssign  j  integer; 
test_case  :  integer; 
last_op,last  s, last  r  :  integer; 
r, s  :  array [H. . 4095J  of  longint; 
op  :  array [0.. 31]  of  word; 
cflag,  zflag  :  integer; 
continuous  :  char; 
stop__on_error  :  char; 
count  :  integer; 
test_cycle  :  longint; 
no_error  :  longint; 

procedure  write_error (procedure_name, message : string) ; 
begin 

writeln (' Error  at  procedure  ' , procedure_name, '  !!!'); 

writeln('  message); 
halt; 
end; 
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procedure  mwrite (bank, offset, pattern: word) ; 
begin 

memw [segment : (bank  shl  13)  +  offset]  :=  pattern; 
end; 

function  mread (bank, of fset : word) :word; 
begin 

mread  z-  memw [segment : (bank  shl  13)  +  offset]; 
end; 

procedure  verify (bank, offset, data, expdata: word)  ; 
begin 

if  data  <>  expdata  then 
begin 

writeln (' error  at  bank  ',bank,'  at  location  '  , word_to_hex (of f set ) ) ; 
writeln  ('  written:  ', wo rd_to_hex (expdata) ) ; 
write  ('  read  :  9  , word_to_hex (data) , 9  <CR>  ');  readln; 
writeln; 
end; 
end; 

procedure  test_memory; 
begin 

stop_processor; 
pattern  [0]  :=  $1234; 
pattern [1]  z-  $0000; 
pattern [2]  $5555; 

pattern [3]  :=  $aaaa; 

pattern[4]  :=«  $ffff; 
pattern[5]  z-  $ff00; 
pattern[6]  :=  $00ff; 

write  ('test  all  banks  ?  ');  readln (ch) ; 
if  (ch  -  9 yf )  or  (ch  =  'Y'  )  then 
begin 

start  Joank  :=  0;  end_bank  :=  7; 
end 
else 
begin 

write ('Which  bank  to  test  ?  '); readln (start_bank) ; 
end_bank  :=  start_bank; 
end; 
begin 

for  bank  :=  start_bank  to  end_bank  do 
begin 

for  i  :=*  0  to  6  do 
begin 

address  :=  0; 

writeln (' testing  pattern  ', word_to_hex (pattern [i] ), '  on  bank  ',bank) 

while  address  <=  $lffe  do 

begin 

mwrite (bank, address, pattern [i] ) ; 

verify (bank, address, mread (bank, address) , pattern [i] ) ; 
address  :=  address  +2; 
end; 
end; 

address  :=  0; 

writeln (' writing  address  on  bank  ',bank); 

while  address  <=  $lffe  do 

begin 

mwrite (bank, address, address) ; 
address  :=  address  +2; 
end; 

address  :=  0; 

writeln (' reading  address  on  bank  ',bank); 

while  address  <=  $lffe  do 

begin 

verify (bank, address, mread (bank, address) , address) ; 
address  :=  address  +  2; 
end; 
end; 

if  (ch='y')  or  (ch='Y')  then 
begin 

address  :=  0; 

writeln (' writing  address  to  all  banks'); 
repeat 

mwrite (0, address, address) ; 
address  :=  address  +  2; 
until  address  =  $fffe; 
mwrite (0, address, address) ; 
address  :=  0; 

writeln (' reading  address  from  all  banks'); 
repeat 
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verify (0, address, mread  <0, address)  ,  address)  ; 
address  :=  address  +  2; 
until  address  =  $fffe; 

verify (0, address, mread (0, address) , address) ; 
end; 

if  <ch  <>  'y')  and  (ch  <>  ' Y' )  then  exit; 
end; 

writeln (' memory  testing  completed'); 
end;  {  of  test__memory  } 

procedure  write_fpu_vector (address :word; r, s : longint ;op :word) 

var  lsw,msw  :  longint; 

begin 

address  :=  address  shl  1; 

Isw  :=  $0000ffff  and  r; 
msw  r  shr  16; 

mwrite (0, address,  lsw)  ; 
mwrite (1, address, msw) ; 

verify (0, address, mread (0, address) , lsw) ; 

verify (1, address, mread (1, address) , msw) ; 

lsw  :=  $0000ffff  and  s; 

msw  s  shr  16; 

mwrite (2, address,  lsw) ; 

mwrite (3, address, msw)  ; 

verify (2, address, mread (2, address) , lsw) ; 
verify (3, address, mread (3, address)  , msw) ; 
op  :=  op  or  $0200;  {  set  proc_run  to  1  ) 
mwrite (4, address, op) ; 

verify ( 4, address, mread (4, address) , op) ; 
end;  {  of  write_fpu_vector  } 

procedure  check_fpu_vector (address :word;r, s: longint ; op : word) 

var  lsw, msw  :  longint; 

begin 

address  :=  address  shl  1; 
lsw  :=  $0000ffff  and  r; 
msw  r  shr  16; 

verify (0, address, mread{0, address)  ,  lsw)  ; 
verify (1, address, mread (1, address) , msw) ; 
lsw  :=  $0000ffff  and  s; 
msw  :=  s  shr  16; 

verify (2, address, mread (2, address) , lsw) ; 
verify (3, address, mread (3, address) , msw) ; 
op  :=  op  or  $0200;  {  set  proc_run  to  1  } 
verify (4, address, mread (4, address)  ,  op) ; 
mwrite ( 6, address+8, 0) ; 
mwrite (7, address+8, 0) ; 

verify (6, address, mread (6, address+8) , 0) ; 
verify (7, address, mread (7, address+8 ) , 0) ; 
end;  {  of  write_fpu_vector  } 

function  sm2twosc (d: longint) : longint; 
begin 

if  (d  and  $80000000)  <>  0  then 
d  :=  - (d  and  $00ffffff) 
else 

d  :=  d  and  $00ffffff; 
sm2twosc  d; 
end; 

function  twosc2sm (d : longint ) : longint; 
begin 

if  (d  <  0)  then 

d  :=  (-d  and  $7fffffff)  or  $80000000; 
if  (d  and  $01000000)  <>  0  then  cflag  1; 
twosc2sm  :=  d  and  $80ffffff; 
end; 

f unct ion  compute_f add ( r , s : longint ) : longint ; 
var 

addsubsel,expdiff,bgta,explarge  :  longint; 
output, mant large, intermediate, i  ;  longint; 
sexp, rexp, smant, rmant , ssign, rsign  :  longint; 
overflow, underflow  :  longint; 
begin 

sexp  :=  (s  and  $7f800000)  shr  23; 
rexp  :=  (r  and  $7f800000)  shr  23; 
smant  :=  s  and  $007fffff; 

if  (s<>0)  then  smant  :=  smant  or  $00800000; 
rmant  :=  r  and  $007fffff; 

if  (r<>0)  then  rmant  :=  rmant  or  $00800000; 
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ssign  :=  (s  and  $80000000)  shr  31; 
rsign  :=  (r  and  $80000000)  shr  31; 

addsubsel  :=  (1  xor  ssign  xor  rsign); 

expdiff  :=  rexp  -  sexp; 

bgta  :=  0; 

explarge  :=  rexp; 

output  :=  rsign; 

if  (expdiff  <  0)  then 
begin 

expdiff  :=  -expdiff; 
bgta  :=  1; 
explarge  :=  sexp; 
output  :=  ssign; 
end; 

explarge  :=  explarge  +  1; 

if  (bgta  -  0)  then 
begin 

if  (expdiff>“l)  then 

intermediate  smant  shr  (expdiff-1) 
else 

intermediate  :=  smant  shl  1; 
mant large  :=  rmant  shl  1; 

end 

else 

begin 

if  (expdiff>~l)  then 

intermediate  :=  rmant  shr  (expdiff-1) 
else 

intermediate  :=  rmant  shl  1; 
intermediate  :=  rmant  shr  (expdiff-1); 
mant large  :=  smant  shl  1; 

end; 

if  (expdiff  >  23)  then  intermediate  :=  0; 

if  (addsubsel  -  1)  then 

intermediate  :=  mantlarge  +  intermediate 
else 

intermediate  :=  mantlarge  -  intermediate; 

if  (intermediate  <  0)  then 
begin 

intermediate  :=*  -intermediate; 
output  :=  output  xor  1; 
end; 

intermediate  :=  intermediate  shr  1; 

{writeln (' intermed  ' , longint_to_hex (intermediate) ) ; } 
i  :=  0; 

while  (  ((intermediate  and  $01000000) =0)  and  (i<25)  )  do 
begin 

intermediate  :=  intermediate  shl  1; 
explarge  :=  explarge  -  1; 
i  s=  i  +  1; 
end; 

intermediate  intermediate  shr  1; 

overflow  :=  (explarge  and  $100)  shr  8; 

underflow  :=*  (explarge  and  $80  )  shr  7; 

if  {  (underflow  and  overflow)  <>  0  )  then 
begin 

output  :»  0; 
z flag  1; 
overflow  :=  0; 

end 

else 

begin 

output  output  shl  31; 

output  output  or  (  (explarge  and  $ff)  shl  23  ) ; 

output  output  or  (  intermediate  and  $7fffff  ) ; 

end; 

if  (intermediate  *  0)  then 
begin 

output  0; 

zflag  :»  1; 
overflow  :=  0; 
end; 
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cflag  :=  0; 

{  if  (output  <>  0)  then 

writeln (' fmant' , longint_to_hex (  (output  and  $7ffffff)  or  $8000000  )) 
else 

writeln {' fmant' , longint_to_hex (  0  )); 
writeln ( ' f  ' , longint_to_hex (output ) ) ; 

writeln (' fexp  '  , longint_to_hex (  (output  and  $7f 800000)  shr  23  )); 


compute_fadd  :  =  output; 
end; {  of  compute_fadd  ) 

function  compute_fmult (r, s : longint ) : longint; 
var 

rmanthi, rmantlo, smanthi, smantlo  :  longint; 
output, w, x, y, z, reshi, reslo, intermediate  :  longint; 
sexp, rexp, smant, rmant, ssign, rsign  :  longint; 
overflow, underflow  ;  longint; 
begin 

sexp  (s  and  $7 f8 00000)  shr  23; 

rexp  :=  (r  and  $7f800000)  shr  23; 

smant  :=  s  and  $007fffff; 

if  (s<>0)  then  smant  :*  smant  or  $00800000; 
rmant  :=  r  and  $007fffff; 

if  (r<>0)  then  rmant  :=  rmant  or  $00800000; 
ssign  :=  (s  and  $80000000)  shr  31; 

rsign  :=  (r  and  $80000000)  shr  31; 

rmantlo  :=  rmant  and  $ffff; 

rmanthi  rmant  shr  16; 

smantlo  :*  smant  and  $ffff; 

smanthi  smant  shr  16; 

w  :=*  rmantlo  *  smantlo; 

x  :■  rmanthi  *  smantlo; 

y  rmantlo  *  smanthi; 

z  rmanthi  *  smanthi; 

intermediate  ;*  (  (w  shr  16)  and  $ffff  )  +  x  +  y; 

reslo  (  (intermediate  shl  16)  and  $ffff0000  )  or  (w  and  $ffff) ; 

reshi  :=  (  (intermediate  shr  16)  and  $ffff  )  +  z; 

{  writeln  ('  rmant  ',  longint__to_hex  (rmant ))  ; 

writeln { 9  smant  9  , longint_to_hex (smant) ) ; 
writeln (' reshi  9 , longint_to_hex (reshi) ) ; 
writeln (' reslo  9 , longint_to_hex (reslo) ) ; 

} 

intermediate  :=  rexp  +  sexp; 

if  (  (reshi  and  $8000)  <>  0  )  then 

begin 

output  :=  (reshi  shl  8)  or  (  (reslo  shr  24)  and  $ff  ); 
intermediate  :=  intermediate  -  126; 

end 

else 

begin 

output  ;=  (reshi  shl  9)  or  (  (reslo  shr  23)  and  $lff  ); 
intermediate  :=  intermediate  -  127; 
end; 

overflow  :=  (intermediate  and  $100)  shr  8; 
cflag  :«  0; 
zflag  :=  0; 

underflow  :=  (  (  (not  rexp)  and  (not  sexp)  )  shr  7  )  and  1; 

if  (  (overflow  and  underflow)  <>  0  )  then 

begin 

output  i-  0; 
zflag  :=  1; 
overflow  0; 

end 

else 

begin 

output  :=*  output  and  $7fffff; 

output  :*  output  or  (  (ssign  xor  rsign)  shl  31) ; 
output  :=  output  or  (  (intermediate  and  $ff)  shl  23  ); 
end; 

if  (  (reshi  or  reslo)  =  0  )  then 
begin 

output  0; 
zflag  :*  1; 
overflow  :«  0; 
end; 
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compute_fmult  :=  output; 
end; {  of  compute_fmult  } 

function  compute__f  loat  (r :  longint)  :longint; 
var 

explarge  :  longint; 
output, intermediate, i  :  longint; 
rexp,  rmant,  rsign  :  longing- 
overflow,  underflow  :  longint; 
begin 

rmant  :=  r  and  $00ffffff; 

rsign  :=  (r  and  $80000000)  shr  31; 

explarge  :=  $97; 
intermediate  :=  rmant; 

i  :=  0; 

while  (  ((intermediate  and  $01000000) =0)  and  (i<25)  )  do 
begin 

intermediate  :=*  intermediate  shl  1; 
explarge  :=  explarge  -  1; 
i  i  +  1; 
end; 

intermediate  :=  intermediate  shr  1; 

overflow  :=  (explarge  and  $100)  shr  8; 
underflow  (explarge  and  $80  )  shr  7; 

if  (  (underflow  and  overflow)  <>  0  )  then 
begin 

output  :=  0; 
zflag  1; 
overflow  :=  0; 

end 

else 

begin 

output  :=  rsign  shl  31; 

output  s*  output  or  (  (explarge  and  $ff)  shl  23  ) ; 
output  :«  output  or  (  intermediate  and  $7fffff  ) ; 
end; 

if  (intermediate  *  0)  then 
begin 

output  :=  0; 
zflag  :=  1; 
overflow  :=  0; 
end; 

cflag  :=  0; 

compute_f loat  :*  output; 
end; {  of  compute_f loat  } 

function  compute_unp_exp (r: longint) : longint; 
var 

explarge  :  longint; 
output, intermediate, i  :  longint; 
rexp,  rmant,  rsign  :  longing- 
overflow,  underflow  :  longint; 
begin 

rexp  (r  shr  23)  and  $ff; 
rsign  :=  0; 
rexp  :=  rexp  -  127; 
if  (rexp  <  0)  then 
begin 

rexp  :=  -rexp; 
rsign  :=  1; 
end; 

explarge  :*  $97; 
intermediate  :=  rexp; 
i  :=  0; 

while  (  ((intermediate  and  $01000000) *0)  and  (i<25)  )  do 
begin 

intermediate  :=  intermediate  shl  1; 
explarge  explarge  -  1; 
i  :=*  i  +  1; 
end; 

intermediate  intermediate  shr  1; 
output  :=  rsign  shl  31; 

output  :■  output  or  (  (explarge  and  $ff)  shl  23  ); 
output  :=  output  or  (  intermediate  and  $7fffff  ); 
zflag  :*  0; 
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if  (intermediate  =  0)  then 
begin 

output  :=  0; 
zflag  :=  1; 
overflow  0; 
end; 

cflag  0; 

compute_unp_exp  :=  output; 
end; {  of  compute_unp_exp  } 

function  compute_int (r: longint; round: integer) rlongint; 
var 

expdiff, bgta, reshi  :  longint; 
output, intermediate, carryin  :  longint; 
r exp, rmant, r sign  :  longint; 
overflow, underflow  :  longint; 
begin 

rexp  (r  and  $7f800000)  shr  23; 

rmant  :  =  r  and  $007fffff; 

if  (r<>0)  then  rmant  :=  rmant  or  $00800000; 
rsign  :=  (r  and  $80000000)  shr  31; 

expdif f  :=  $00000096  -  rexp; 
reshi  :=  $96; 
intermediate  :=  rmant; 
bgta  : —  1; 

if  (expdiff  <  0)  then 
begin 

reshi  :-  rexp; 
expdiff  :=  -expdiff; 
bgta  :=  0; 
end; 

if  (expdiff  >  0)  then 

carryin  :=  {  intermediate  shr  (expdiff  -  1)  )  and  1 
else 

carryin  :=  0; 

intermediate  :=  intermediate  shr  (expdiff  *  bgta) ; 

if  (  (round=l)  and  (bgta=l)  )  then  intermediate  :=  intermediate  +  carryin; 
if  (  (bgta=l)  and  (expdiff>24)  )  then  intermediate  :=  0; 
reshi  :=  reshi  +  1; 

overflow  :=  0; 
cflag  :=  0; 
zflag  0; 

if  (reshi  <>  $97)  then  overflow  :=  1; 
if  (intermediate  =  0)  then  zflag  :=  1; 

if  (  zflag=l  )  then 
output  :=  0 
else 
begin 

output  :=  rsign  shl  31; 

output  :=  output  or  (  intermediate  and  $ffffff  ); 
end; 

compute_int  output; 
end; {  of  compute_int  } 

procedure  check_fpu_result (address :word; r, s : longint ; op: word) ; 
var  f , msw, lsw, readf  :  longint; 
tr,ts  :  longint; 
rsign, ssign  :  longint; 
sr, ss  :  single; 

readcflag, readzf lag  :  integer; 
i  :  integer; 

sexp, rexp, fexp, smant, rmant, fmant  :  longint; 

Year, Month, Day, DayOfWeek  :  word; 

Hour, Minute, Second, SeclOO  :  word; 
begin 

cflag  :=  0; 
zflag  :=  0; 

address  (address+4)  shl  1; 
case  op  of 

fpu_and:  f  :=  r  and  s; 

fpu_or  :  f  :-  r  or  s; 
fpu_xor  :  f  :=  r  xor  s; 
fpu_notR:  f  : =  not  r; 
fpu_notS:  f  :=  not  s; 
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fpu_passR:  f  :=  r; 

fpu_add  :  f  :=  twosc2sm{sm2twosc (r)  +  sm2twosc (s) ) ; 
fpu_sub  :  f  :=  twosc2sm(sm2twosc (r)  -  sm2twosc (s) ) ; 
fpu_rsub  :  f  :=  twosc2sm (sm2twosc (s)  -  sm2twosc (r) ) ; 
fpu_mult  : 
begin 

ssign  s  and  $80000000; 
rsign  :=  r  and  $80000000; 
tr  :«  r  and  $ffffff; 
ts  s  and  $ffffff; 
f  :=  0; 

for  i  s=  0  to  23  do 
begin 

if  (ts  and  1)  =  1  then  f  :=  f  +  tr; 
tr  :=*  tr  shl  1;  ts  :=  ts  shr  1; 
end; 

if  (f  and  $01000000)  <>  0  then  cflag  :=  1; 

if  f  *  0  then 

begin 

rsign  :=  0; 
ssign  :=  0; 
end; 

f  (rsign  xor  ssign)  or  (f  and  $00ffffff) ; 
end; 

{  float  } 

fpu_fadd  2  f  compute_fadd (r, s) ; 

fpu_fsub  :  f  compute_fadd (r, (s  xor  $80000000)); 

fpu  fmult :  f  z=  compute_fmult (r,  s) ; 

fpu_frsub:  f  :=  compute_fadd ( (r  xor  $80000000) , s) ; 

fpu  ror  :  f  :=  ( (r  shl  (32  -  (s  and  $lf ) ) )  or  (r  shr  (s  and  $lf ) ) ) 

f pu_ro 1  :  f  :=  (jr  shr  (32  -  (s  and  $lf) ) )  or  (r  shl  (s  and  $lf) ) ) 

fpu_shr  :  f  :=  r  shr  (s  and  $lf) ; 

fpu_shl  :  f  :=  r  shl  (s  and  $lf ) ; 

fpu  pack  : 

begTn 

f  :=  r  and  $ffffff; 
if  (  (r  and  $80000000) =0  )  then 
f  :=  127  +  f 
else 

f  :=  127  -  f; 
cflag  :=  0; 
zflag  0; 

if  (  (f  <  0)  or  ((f  and  $ff)-0)  ) then 
begin 
f  ;=  0; 
zflag  2*  1; 
end; 

f (  (f  shl  23)  and  $7f800000  ); 
end; 

fpu_float  :  f  2  —  compute_f loat (r) ; 

fpu_seed  2 

begin 

f  2  —  (r  and  $7f800000)  shr  23; 
f  :=  f  +  2; 
cflag  2=  0; 
zflag  2=  0; 

if  (  (r  and  $7fffffff)«0  )  then 
begin 

zflag  :=  1; 
f  2-  0; 

end 

else 

begin 

f  :«  (r  and  $80000000)  or  (  (f  and  $ff)  shl  23  )  or  $400000; 
f  ;»  f  xor  $7f 800000; 
end; 
end; 

fpu_unp__exp  2  f  compute__unp_exp  (r)  ; 
fpu  unp  man  2 
begin  " 

f  ;=  (s  and  $807f f f f f )  or  $3f800000; 
zflag  2*  0; 
cflag  2=  0; 

if  (  (s  and  $7f f f f f f f )  -  0  )  then 
begin 

zflag  2=  1; 
f  2-  0; 
end; 
end; 

fpu_rootexp  2 
begin 
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if  ((r  and  $80000000) =0)  then 

if  {  (r  and  $00800000)  <>  0  )  then 
f  :=»  {  (r  shr  24)  and  $7f  )  +  64 
else 

f  :=  (  (r  shr  24)  and  $7f  )  +  63 

else 

if  (  (r  and  $00800000)  <>  0  )  then 
f  :=  -(  (r  shr  24)  and  $7f  )  +  64 
else 

f  (r  shr  24)  and  $7f  )  +  63; 

if  (f<0)  then  f  -f; 
f  (f  and  $ff)  shl  23; 
cf lag  :=  0; 
zflag  0; 

if  (<r  and  $7f f f f f f f ) =0)  then 
begin 

zflag  1; 
f  :=  0; 
end; 
end; 

fpu  rootman  ; 
begin 

if  (  (s  and  $00800000)  -  0)  then 

f  :=  (s  and  $007fffff)  or  $40000000 

6  Sf  :=  (s  and  $007fffff)  or  $3f800000; 
cflag  :=*  0; 
zflag  :=  0; 

if  Ms  and  $7f f f f f f f )  =0)  then 
begin 

zflag  :=  1; 
f  :=  0; 
end; 
end; 

fpu_round  :  f:=*  compute_int (r, 1) ; 
fpu_int_r  :  f:=  compute^int  (r, 0)  ; 
fpu_int_s  :  f:=  compute_int (s,  0) ; 
fpu_sin_sgn  : 
begin 

f  (s  xor  (r  shl  31) )  and  $80000000; 
f  f  or  (s  and  $7fffffff); 
zflag  :=  0; 
cflag  z-  0; 

if  Mf  and  $7f  f f  ff  f  f )  *0)  then 
begin 

zflag  1; 

f  :  *=  0  ; 
end; 
end; 

fpu_odd_neg  : 
begin 

f  :=  (s  shl  31)  or  (s  and  $fff fff) ; 
zflag  :=  0; 
cflag  :=  0; 

if  Ms  and  $ffffff)=0)  then 
begin 

zflag  1; 

f  :=  0; 
end; 
end; 

fpu  chg_sgn  : 
begin 

f  :=  <r  and  $80000000)  or  (s  and  $7fffffff) 
zflag  :=  0; 
cflag  :=  0; 

if  Ms  and  $7ffff fff ) =0)  then 
begin 

zflag  :=  1; 
f  0; 
end; 
end; 

fpu  tan_sgn  : 
begin 

f  :«  (r  shr  31)  xor  (s  shr  31)  xor  r; 
f  f  shl  31; 

f  f  or  (s  and  $7fffffff) ; 

cflag  :»  0; 
zflag  0; 

if  Mf  and  $7fffffff)-0)  then 
begin 

zflag  :*  1; 
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0; 


f  :  = 
end; 
end; 

end;  {  of  opcode  case  } 

if  (f=0)  then  zflag  1  else  zflag  0; 

lsw  mread (6, address) ; 

msw  mread (7, address)  ; 

readf  :=  {msw  shl  16)  or  lsw; 

lsw  :=*  mread (5, address)  ; 

readcflag  :=  (lsw  and  1) ; 

readzflag  :=  (lsw  and  2)  shr  1; 

if  (readf  <>  f)  or  (readcflag  <>  cflag)  or  (readzflag  <>  zflag)  or  (debug)  then 
begin 

if  (readf  <>  f)  or  (readcflag  <>  cflag)  then  no__error  :=  no_error  +  1; 
write (word_to_hex (address  shr  2) , ' : ' , longint_to_hex (r) , '  '); 
case  op  of 

fpu_and  :  write {'and  '); 
fpu_or  :  write  ('or  '); 
fpu_xor  :  write {'xor  '); 
fpu_add  :  write  ('fix+  '); 
fpu_sub  :  write {'fix-  '); 
fpu_mult:  write ('fix*  '); 
fpu_rsub :  write ( ' f ixr- ' ) ; 
fpu_passr:  write (' passR' ) ; 
fpu_pack  :  write {'pack  exp  R' ) ; 
fpu__float  :  write ('float  R'); 

fpu_seed  :  write {'inv  seed  R' ) ; 

fpu_unp_exp  ;  write (' unpack  exp  R' ) ; 
fpu_unp_man  :  write (' unpack  mant  S'); 
fpu_rootexp  :  write ('root  exp  R' ) ; 
fpu_rootman  :  write {'root  mant  S' ) ; 
fpu_round  :  write ('round  R' ) ; 
fpu_int_r  *:  write  ('  truncate  R' )  ; 
fpu_int_s  :  write (' truncate  S'); 
fpu_sin_sgn  :  write ('sine  sign'); 
fpu_odd_neg  :  write ('odd  negative  S' )  ; 
fpu_chg_sgn  :  write (' change  sign'); 
fpu_tan_sgn  :  write (' tangent  sign'); 
fpu__fadd  :  write  {' float+  '); 
fpu_fsub  :  write (' float-  '); 
fpu_fmult:  write (' float*  '); 
fpu_frsub:  write {' floatr-' ) ; 
end; 

write ('  ' , longint_to_hex (s)  , '  ->  ' )  ; 

write  (longint_to__hex{f zflag, cflag, '  ]  (pc)  '); 

write (longint  to_hex (readf ),'[', readzflag, readcflag, ' ]  (fpu)  '); 

if  (readf  <>  7)  or  (readcflag  <>  cflag)  then 

begin 

GetTime (Hour, Minute, Second, SeclOO) ; 

GetDate (Year, Month, Day, DayOfWeek) ; 

write('Date:  ', Month, '/', Day, '/', Year, '  at  ', Hour, Minute, Second, '  '); 
if  (command  =  'tall')  then  writeln (' Error  at  cycle  ', count,'.') 

else  writeln ('Error  at  cycle  ' , test_ cycle, '  •' ) ; 

end; 

if  (stop_on  error  =  'y')  then  readln  else  writeln; 
end;  {  of  rea<3f  <>  f} 
end;  {  of  check_fpu_result  } 

procedure  generate_vectors (phase  :  integer) ; 

var  i,j,k  :  integer; 

begin 

address  :=  2; 

writeln (' generating  test  vectors  phase  ', phase); 
case  phase  of 
0: 

for  k  :=  0  to  last_op  do 
for  j  :=  0  to  last_s  do 
for  i  :=  0  to  last_r  do 
begin 

if  address  >-  max_test_vector  then  write_error ( ' ' , ' too  many  test  vectors'); 
write_fpu_vector (address, r [i] , s [ j] , op [k] ) ; 
address  :=  address  +  1; 
end; 

1: 

for  k  :=  0  to  last_op  do 
for  i  :=  0  to  last_r  do 
for  j  :=  0  to  last_s  do 
begin 

if  address  >=  max_test_vector  then  write_error ( ' ' , ' too  many  test  vectors'); 
write_fpu_vector (address, r [i] , s [ j] , op [k] ) ; 
address  :=  address  +  1; 
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end; 

2: 

for  j  :=  0  to  last_s  do 
for  i  z-  0  to  last_r  do 
for  k  :=  0  to  last_op  do 
begin 

if  address  >=  max_test__vector  then  write_error  (' 9 , 1  too  many  test  vectors') 
write_fpu_vect or  (address,  r  [i] ,  s  [  j]  ,op[k] )  ; 
address  :=  address  +1; 
end; 

end; 

end;  {  of  generate_vectors  } 

procedure  wait; 
var  i  s  integer; 
begin 

for  i  :=  0  to  4095  do; 
end;  {  of  wait  } 

Procedure  check_vectors (phase  :  integer); 

var  i,j,k  :  integer; 

begin 

writeln (' checking  test  vectors  phase  phase); 

stop_processor; 

address  :=  2; 

case  phase  of 

0: 

for  k  :=  0  to  last_op  do 
for  j  :=  0  to  last _s  do 
for  i  :=*  0  to  last_r  do 
begin 

check_fpu_vector (address, r [i] , s [ j] , op [k] ) ; 
address  :=»  address  +  1; 

end; 

1: 

for  k  :=  0  to  last_op  do 
for  i  :=*  0  to  last_r  do 
for  j  :=  0  to  last_s  do 
begin 

check_fpu_vector (address, r [i] ,  s [ j] ,  op [k] ) ; 
address  :=  address  +  1; 

end; 

2: 

for  j  :=  0  to  last_s  do 
for  i  :=  0  to  last_r  do 
for  k  :=  0  to  last_op  do 
begin 

check_fpu_vector (address, r [ i] , s [ j ] , op [k] ) ; 
address  :=  address  +  1; 

end; 

end; 

end;  {  of  check_vectors  } 

procedure  check_results (phase  :  integer); 

var  i,j,k  :  integer; 

begin 

writeln (' checking  test  result'); 

start_processor; 

wait  ; 

address  :=  2; 
stop_processor; 
case  phase  of 
0  : 

for  k  :=  0  to  last_op  do 
for  j  :=  0  to  last_s  do 
for  i  0  to  last__r  do 
begin 

if  not  odd(k)  then 

check_fpu_result (address, r [i] , s ( j] , op [k] ) ; 
address  :=  address  +  1; 
end; 

1  : 

for  k  :=  0  to  last_op  do 
for  i  :=  0  to  last_r  do 
for  j  :*  0  to  last_s  do 
begin 

if  not  odd(k)  then 

check_fpu_result (address, r[i],s[j],op[k]); 
address  :=  address  +  1; 
end; 

2  : 

for  j  :=  0  to  last _s  do 
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for  i  :=  0  to  last_r  do 
for  k  :=  0  to  last_op  do 
begin 

if  not  odd(k)  then 

check_fpu_result (address, r [ i] , s [ j 3 , op [k] ) ; 
address  :=  address  +  1; 
end; 

end; 

end;  {  of  check_result  } 

procedure  test_random; 
var  i, j  :  integer; 
begin 

writeln (' —  random  pattern  test'); 

stop_processor; 

writeln  ('generate  vectors'); 

j  0; 

for  i  2  to  4090  do 
begin 

r(i]  random ($ffff) ; 

r[i]  :=  (r [i]  shl  16)  or  random ($f fff ) ; 
s[i]  :=  r [i] ; 

write_fpu_vector (i, r [i] , s [i] , op [ j] ) ; 
if  j  =  last_op  then  j  0  else  j  :*  j+1; 
end; 

writeln (' checking  vectors'); 

j  0; 

for  i  :=  2  to  4090  do 
begin 

check_fpu_vector (i, r [i] , s ( i] , op  [  j] ) ; 
if  j  -  last_op  then  j  :»  0  else  j  :*  j+1; 
end; 

start_processor; 

wait; 

writeln (' checking  fpu  results'); 
stop_processor; 

j  :=  0; 

for  i  2  to  4090  do 
begin 

if  not  odd(j)  then 

check_fpu_result (i, r [i] , s { i] , op [ j ] ) ; 
if  j  =  last_op  then  j  :=  0  else  j  :=  j+1; 
end; 

end;  {  of  test_random  } 


procedure  test_logical; 
var 

phase  :  integer; 
begin 

writeln (' —  xor/and/or/passR  tests  — '); 
test  case  :=  logical; 

op[0T  fpujpassR;  op[l]  :=  not  op[0]; 
op  [2]  :=  fpu_and;  op  [3]  :=*  not  op  [2]; 

op  [4]  :=  fpu_or;  op [5]  :=  not  op [4]; 

op [6]  :=  fpu_xor;  op [7]  :=  not  op [6]; 

op [8]  :=  fpu_xor;  op [9]  :=  not  op [6]; 

last_op  :=  9; 
test_cycle  :=  0; 
repeat 

writeln (' -  logical  test  cycle  ' , test_cycle, ' 

test_cycle  :=  test_cycle  +  1; 
writeln (' —  fixed  pattern  test'); 


r  [0] 
r [4]  :» 
last  r 


$ff f fff ff ;  r [2] 
$00000000;  r[6] 


$ffffffff ;  s [2] 
$00000000;  s [6] 


$00000000;  r [1] 

$fffff f f f ;  r [5] 

7; 

s  [0]  :=  $00000000;  s[l] 
s [4]  $ff ff fff f ;  s [5] 
last_s  s*  7; 
for  phase  :=  0  to  2  do 
begin 

generate_vectors (phase) ; 
check_vectors (phase) ; 
check_results (phase) ; 
end; 

test  random; 

until  "[continuous  <>  'y')  and  (continuous  <>  'Y'); 
end;  (  of  test_logical  } 


$55555555;  r[3] 
$12345678;  r[7] 


$55555555;  s[3] 
$12345678;  s[7] 


procedure  test_iadd; 
var 

phase  ;  integer; 
begin 


»  $aaaaaaaa 
=  $9abcdef0 

=  $aaaaaaaa 
=  $9abcdef0 
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test_case  :=  iadd; 
test_cycle  :=  1; 

writeln {'begin  integer  add/sub/rsub  tests'); 

op[0]  : =  fpu_add;  op[l]  :=  1 

op [2]  :=  fpu_sub;  op [3]  :=  l 
op [4]  :=  fpu_rsub;  op [5]  :=  i 
last_op  :=  5; 

test_cycle  :=  1; 
repeat 

writeln  (' -  integer  add 

test_cycle  test_cycle  + 
writeln (' —  fixed  pattern  i 
r  [0]  :  =  $00000000;  r[l]  :  = 
r[4]  :=  $00000001;  r[5] 
r [8 ]  :=  $80555555;  r[9]  := 
r  [12]  :=*  $80abcdef ; 
last  r  :=  12; 

s[03~:«  $00000000;  s[l]  := 
s [4 ]  :*  $00000001;  s[5] 
s [ 8 ]  :=  $80555555;  s[9]  := 
s[123:=  $80abcdef; 
last_s  :=  12; 
for  phase  0  to  2  do 
begin 

generate_vectors (phase) ; 
check_vectors (phase) ; 
check_results (phase) ; 
end; 

test_random; 

until  (continuous  <>  ' y' )  and  (continuous  <>  'Y'); 
end;  {  of  test_fix  } 

procedure  test_imult; 
var 

phase  :  integer; 
begin 

test_case  :=  imult; 
test_cycle  :=  1; 

writeln ('begin  integer  mult  tests'); 

op[0]  :=  fpu_mult;  op[l)  :=  not  op[0]; 

last_op  1; 

test_cycle  :=  1; 
repeat 

writeln (' -  integer  mult  test  cycle  ' , test_cycle, '  - '); 

test_cycle  :=  test__cycle  +  1; 
writeln (' —  fixed  pattern  test'); 
r  [0]  $00000000; 

r [1]  :=  $00f f f f f f ;  r[2]  :=  $00aaaaaa;  r[33  :=  $00555555; 

r [4]  :=  $00000f ff ;  r[5)  :=  $00000aaa;  r [ 6]  :=  $00000555;  r  [  73  :  = 

r [83  $8000000; 

r [93  :=  $80f f f f f f ;  r (10]  $80aaaaaa;  r [ 11]  $80555555; 

r [12]  :=  $80000fff;  r [13]  $80000aaa;  r[14]  :=  $80000555;  r  [15] 

stoP:=’$00000000; 

s[l]  :=  $00ff f f ff ;  s[2]  :=  $00aaaaaa;  s[3]  :=  $00555555; 

s [4]  :=  $00000f f f ;  s[5]  :=  $00000aaa;  s[6]  ;=  $00000555;  s[7]  := 

s  [8]  :=  $8000000; 

s [9]  :=  $80ff f f ff;  s  [10]  ;=  $80aaaaaa;  s  [11]  :=  $80555555; 

s [12]  :=  $80000fff;  s[13]  :=  $80000aaa;  s[14]  :=  $80000555;  s[15] 

last_s  : -  15; 

for  phase  :=  0  to  2  do 

begin 

generate_vectors (phase) ; 
check_vectors (phase) ; 
check_results (phase) ; 
end; 

test_random; 

until  (continuous  <>  'y')  and  (continuous  <>  'Y'); 
end;  {  of  test_imult  } 

procedure  test_fmult; 
var 

phase  :  integer; 
begin 

test_case  :=  fmult; 
test_cycle  :=  1; 

writeln (' begin  float  mult  tests' ) ; 


lot  op (03; 
lot  op[23; 
lot  op [ 4  3 ; 


test  cycle  ' , test_cycle, '  - '); 

i; 


h  pcf1  ^  )  • 

“$00ffffff;  r (2] 
$00123456;  r[6] 
$80aaaaaa;  r(10] 


$00555555;  r [3] 
$00abcdef ;  r[7] 
$80000001;  r ( 11] 


$00ffffff;  s (2) 
$00123456;  s[6] 
$80aaaaaa;  s[10] 


=  $00555555;  s  [3] 

-  $00abcdef;  s[7] 

=  $80000001;  s  [  11] 


$00aaaaaa; 
$80f f f f f f ; 
$80123456; 


$00aaaaaa 
$80f f f f f f 
$80123456 


$00ff f ff f ; 


:=  $80f f f f f f ; 


$00f f f f f f ; 


:=  $80f f f f f f ; 
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op[0]  :=*  fpu_fmult;  op[l]  :=  not  op[0]; 

last_op  : =  1; 

test_cycle  :=  1; 
repeat 

writeln (' -  floating  mult  test  cycle  '  , test_cycle, '  - '); 

test__cycle  :=  test_cycle  +  1; 
writeln {' —  fixed  pattern  test'); 
r  [0 ]  :=  $00000000; 

r [1]  :=  $3f f ff ff f ;  r[2]  :=  $3faaaaaa;  r[3]  :=  $3f555555; 

r [4]  :*  $00000f f f ;  r [5]  $00000aaa;  r[6]  :=  $7f000555;  r [7]  := 

r [8]  $08000000; 

r [9]  :=  $bfff f fff ;  r[10]  :=  $bfaaaaaa;  r[ll]  :=  $bf555555; 
r [12]  :=  $80000f f f ;  r[13]  $80000aaa;  r[14]  :=  $ff000555;  r [ 15 ] 

last  r  :=  15; 
s[0]”:=  $00000000; 

s[l]  :  =  $3f f f ff f f ;  s [2]  :=  $3faaaaaa;  s[3]  :=  $3f555555; 

s [4 ]  :=  $00000f f f ;  s[5]  :=  $00000aaa;  s[6]  $7f000555;  s[7]  := 

s  [8]  :=  $8000000; 

s [9]  :=  $bf ffff ff ;  s[10]  :  =  $bfaaaaaa;  s [11]  :=  $bf555555; 

s[12]  :=  $80000fff;  s[13]  :*  $80000aaa;  s[14]  $ff000555;  s[15] 

last_s  15; 

for  phase  :=  0  to  2  do 

begin 

generate_vectors (phase) ; 
check_vectors (phase) ; 
check_re suits (phase) ; 
end; 

test_random; 

until  (continuous  <>  ' y' )  and  (continuous  <>  'Y'); 
end;  {  of  test_fmult  } 

procedure  test_fadd; 
var 

phase  :  integer; 
begin 

test_case  fadd; 
test^cycle  :=«  1; 

writeln ('begin  floating  point  add  tests'); 


op[0]  :=  fpu_fadd;  op[l]  :=  not  op[0]; 
op [2]  :=  fpu_fsub;  op [3]  :=  not  op[2]; 
op [4]  :=  fpu_frsub;  op [5]  :=  not  op [4]; 

last__op  :=  5; 


test_cycle  :=  1; 
repeat 

writeln  (' -  floating  add  test  cycle  ' , test_cycle, '  - '); 

test_cycle  :=  test_cycle  +  1; 
writeln (' —  fixed  pattern  test'); 


-  $3f000000; 

=  $3f f f f f f f ;  r [2]  $3faaaaaa;  r[3] 
=  $7f000000;  r [6]  :=  $2a800000;  r[7] 
=  $bf000000 ; 

:=  $bf f f f f f f ;  r [11] 

:=  $ff 000000;  r[15] 

■  :=  17; 

-  $3f000000; 

=  $3f f f f f f f ;  s  [2 ]  :=  $3faaaaaa 


s[3]  := 

$7f 000000;  s  [  6]  :»  $2a800000;  s[7]  :  = 
$bf000000; 


r  [0] 
r  [1] 
r  [5] 
r  [ 9] 
r  [10] 
r  [14] 
last_ 
s[0] 
s[l] 
s[5] 
s[9] 
s  [10] 
s  [14] 
last_s  z- 
for  phase 
begin 

generate_vectors (phase) ; 
check_vectors (phase) ; 
check__results  (phase)  ; 
end; 

test_random; 

until  (continuous  <>  'y') 
end;  {  of  test_fadd  ) 


=  $bfaaaaaa;  r[12] 
=  $aa800000;  r[16] 


$bf f f f f f f ; 
$ff 000000; 
17; 

:=  0  to  2 


s  [11] 
s  [15] 

do 


:«  $bfaaaaaa; 
;=  $aa800000; 


s[12] 
s  [16] 


$3 f5 55555;  r[4]  := 
$55000000;  r[8]  := 

:=  $bf555555;  r[13] 
:=  $d5000000;  r[17] 


$3f555555;  s[4] 
$55000000;  s[8]  := 

:=  $bf 555555 ;  s[13] 
:=  $d5000000;  s[17] 


and  (continuous  <>  'Y'); 


procedure  test_shift; 
var 

phase  :  integer; 
var  i  :  integer; 
begin 

test_ case  :=  shift; 
test_cycle  ;=  1; 

writeln ('begin  ror/rol/shr/shl  tests'); 


$7f f f f f f f ; 

$f f ff f f f f ; 

$7f f f f f ff ; 

;=  $ffffffff; 


$3 fO 00001; 

$00800000; 

:=  $bf000001; 
;=  $80800000; 


$3f000001; 

$00800000; 

:=  $bf 000001; 
;=  $80800000; 
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op[0]  :=  fpu_ror;  op(l]  z-  not  op[0]; 

opt 2]  :=  fpu__rol;  op  [3]  :=  not  op[2]; 

op[4]  :*  fpu_shr;  op [5]  :=  not  op [4]; 

op [6]  :=  fpu_ shl;  op [7]  :=  not  op [6]; 

last_op  7; 

test_cycle  :=  1; 
repeat 

writeln ( ' -  ror/rol/shr/shl  test  cycle  9  , test_cycle, 9  - 9 ); 

test_cycle  test_cycle  +  1; 
writeln  (' —  fixed  pattern  test'); 
r [0]  :=  $00000000; 

r[l]  :=  $ffffffff;  r [ 2 ]  :=  $aaaaaaaa;  r [ 3 ]  :=  $55555555;  r[4]  :=  $01234567 
r[5]  :»  $89abcdef; 
last  r  z-  5; 

for  I  :=  0  to  31  do  s[i]  i; 
last_s  :=  31; 
for  phase  :s  0  to  2  do 
begin 

generate_vectors (phase) ; 
check_vectors (phase) ; 
check_re suits (phase) ; 
end; 

test  random; 

until  "[continuous  <>  'y')  and  (continuous  <>  'Y'); 
end;  {  of  test_shift  } 


procedure  test_specialO; 
var 

phase  :  integer; 
begin 

test_case  :»  special; 
test_cycle  z  =  1; 

writeln (' Testing  Pack  Exp  and  Float'); 
op [0]  fpu_pack;  op[l]  :  =  not  op[0]; 
op [2]  :=  fpu_f loat;  op [3]  :=  not  op[0]; 
last  op  :=  3; 

r ( 0 ]  1;  r[l]  :=  4;  r[2]  :=  16;  r[3]  :=  64;  r[4]  256; 

r [5]  :=  $ffffff; 

r [6]  :=  $80000001;  r[7]  :=  $80000004;  r[8]  :=«  $80000010; 
r  [9]  $80000040;  r[10]  $80000100;  r[ll]  :»  $80ffffff; 

last_r  :=  11; 

s [0]  :=  0;  s[l]  ;=  not  s[0]; 
last_s  :*  1; 
repeat 

writeln (' -  special  test  0  cycle  ' , test_cycle, '  - '); 

test_cycle  :=*  test_cycle  +  1; 
for  phase  :*  0  to  2  do 
begin 

generate__vectors  (phase)  ; 
check_vectors (phase) ; 
check_results (phase) ; 
end; 

test  random; 

until  "(continuous  <>  '  y' )  and  (continuous  <>  '  Y' )  ; 
end;  {  of  test_special0  } 


procedure  test_speciall; 
var 


phase  :  integer; 
begin 

test_case  special; 
test_cycle  :=  1; 

writeln  (' Testing  seed,  unp_exp  and  unp_man. 


op  [0] 
op  [2] 
op  [4 ] 
op  [6] 
op  [8] 
last  op 
r[0]“ 
r  [1] 
r  [2] 
r  [3] 
r  [4] 
r  [5] 
r  [6] 
r  [7] 
last 


fpu_seed;  op[l]  :=  not  op[0]; 
f pu_unp_exp ;  op [ 3 ]  : =  not  op ( 0 ] ; 
'  ~  op  [5]  :=  not  op[0]; 

op [7]  not  op[0] ; 
op(9]  :=  not  op [0] ; 


»  fpu_unp_man; 
=  fpu_rootexp; 
*  fpu  root man; 
■  3  9  * 
$00000000 
$3f f f f f ff 
$00000fff 
$7f 000555 
$08000000 
$bf ff ff f f 
$80000f f f 
$ff 000555 
:»  7; 


s  [ 0 ]  : $00000000; 
s[l]  $3f f f f f f f ; 
s  [2]  :«  $00000f f f ; 


rootexp, 


rootman' ) ; 
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s[3] 

:=  $7f000555; 

s  [43 

:=  $08000000; 

s  [53 

:=  $bf ffffff ; 

s[6] 

:=  $80000f f f ; 

s  [7] 

:=  $ff000555; 

last 

s  7; 

repeat 

writeln { ' -  special  test  1  cycle  ' , test_cycle, ' 

test_cycle  :*  test  cycle  +  1; 
for  phase  :=*  0  to  do 
begin 

generate_vectors (phase) ; 
check^vectors (phase) ; 
check_results (phase) ; 
end; 

test_random; 

until  (continuous  <>  'y')  and  (continuous  <>  ' Y' ) ; 
end;  {  of  test_speciall  } 

procedure  test_special2; 
var 

phase  :  integer; 
begin 

test_case  special; 
test_cycle  :=*  1; 

writeln (' Testing  Round  and  Trunc/Int'); 
op[0]  :=  fpu_round;  op[l]  :=  not  op [03; 

op [2]  :=  fpu_int_r;  op [3]  :=  not  op[0]; 
op  [4]  :=  fpu__int_s;  op  [5]  :=  not  op[0]; 
last_op  :=  5; 
r  [0]  :=  $00000000; 
r  [1]  $3fffffff; 
r  [2]  :=  $4 6000f f f ; 

r  [3]  :=  $3f000555; 
r  [4 ]  :=  $4b000000; 

r  (5 ]  $bf ffffff; 
r  [6]  :=  $c6000f f f ; 
r  [7]  :=  $bf000555; 
last  r  i-  7; 
s[0]“:=  $00000000; 
s[l]  $3f ffffff ; 
s  [2]  $4 6000f f f ; 

s  [3]  :=  $3f 000555; 
s  [4]  :=  $4b000000; 
s  [5]  $bff f ff ff ; 
s  [6]  :=  $c6000f f f ; 
s  [7 ]  :=  $bf000555; 
last_s  :=  7; 
repeat 

writeln (' -  special  test  2  cycle  ' , test_cycle, ' 

test_cycle  :=  test  cycle  +  1; 
for  phase  :=  0  to  1  do 
begin 

generate_vectors (phase) ; 
check_vectors (phase) ; 
check_results (phase) ; 
end; 

test_random; 

until  (continuous  <>  ' y' )  and  (continuous  <>  '  Y'  )  ; 
end;  {  of  test_special2  } 


procedure  test_special3; 
var 

phase  :  integer; 
begin 

test_case  :=  special; 
test_cycle  1; 

writeln (' Testing  Special  Sign  Manipulation'] 


op[0]  :=  fpu_sin_sgn; 

op [2]  :=  fpu_odd_neg; 

op [ 4  j  : =  f pu_chg_sgn ; 
op [6]  :=  fpu_tan_sgn; 

last  op  :=  7; 
r[0]”:  =  $00000000 
r [1]  :=  $00000001 
r [2 ]  :=  $80000010 
r  [3]  $80000001 

r  [  4]  :«  $3f 800000 
r  [5]  :=  $3f 800001 
r  [ 6]  :=  $bf800010 
r  [7]  $bf 800001 

last  r  7; 


op[l] 
op  [3] 
op  [5] 
op  [7 ] 


not  op [03 ; 
=  not  op [0]  ; 
=  not  op [03 ; 
=  not  op [03; 
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s[0}  $00000000; 

s  [1]  :=  $00000001; 
s [2]  :*  $80000010; 
s [3]  :  =  $80000001; 

s [4]  :=  $3f800000; 
s[5]  $3f800001; 

s [6]  $bf800010; 

s [7]  :=  $bf 800001; 
last_s  :=  7; 
repeat 

writeln (' -  special  test  3  cycle  ' ,  test_cycle, '  - '); 

test^cycle  test  cycle  +  1; 
for  phase  :»  0  to  I  do 
begin 

generatejvectors (phase) ; 
check_vectors (phase) ; 
check_re suits (phase) ; 
end; 

test_random; 

until  (continuous  <>  'y')  and  (continuous  <>  'Y' ); 
end;  {  of  test_special3  } 

procedure  substitute_word; 
var  start_address,  data  :  word; 

xd  :  string; 
begin 

write  ('  start  address  ?  ');  readln  <start__address)  ; 

if  odd  (star t_address)  then  start_address  start_address  -  1; 

repeat 

write (word_to_hex( start  address) , ' : ' , word_to_hex (mread (bank, start_address) ) ) 
write  ('  ->  ' ) ;  readln (xd); 
if  xd  <>  'quit'  then 
begin 

data  :=  hex_to_word (xd) ; 
mwrite (bank, start_address, data) ; 

verify (bank, address, mread (bank, start_address) ,data) ; 
start_address  :=  start^address  +  2; 
end; 

until  xd  =  'quit'; 
end;  {  of  subs ti tut e_word  } 

procedure  display__word; 

var  i, start_address,  no_word  :  word; 

begin 

write {'start  address  ?  ' ) ;readln (start_address) ; 

if  odd (start_address)  then  start_address  :=  start_address  -  1; 

write  ('no  of  words  ?  ' ) ; readln (no_word) ; 

writeln (' memory  bank  ',bank); 

i  :=  start_address; 

while  i  <=  (start_address  +  no__word*2)  do 
begin 

writeln (word_to_hex (i) , ' : ' , word_to_hex (mread (bank, i) ) ) ; 
i  :=  i  +  2; 
end; 

end;  {  of  display_word  } 

procedure  select_bank; 
begin 

write ('bank  s  ',bank,'  ->  '); readln (bank) ; 
end;  {  of  select_bank  ) 

procedure  t; 
begin 

stop_processor; 
for  i  :*  0  to  32  do 
begin 

mwrite (4, i  shl  lri); 

verify (4, i  shl  l,mread(4,i  shl  l),i); 
end; 

start_processor; 

end; 

procedure  toggle_debug; 
begin 

if  debug  *  true  then 
begin 

debug  false; 
writeln ('debugging  off' ) ; 

end 

else 

begin 

debug  :*»  true; 
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writeln (' debugging  on'); 
end; 
end; 

Procedure  test_all; 
var  local_cont  :  char; 
begin 

local_cont  :=  continuous; 
continuous  :=  'n'; 
count  :=  1; 
repeat 

writeln { ' ***  Test  all  functions  ***  Cycle  count,'  (errors  =  ' , no_error, ' )  ***' ) 
test  logical; 

writeln {'******************************************************' ) ; 
test  iadd; 

writeln ('******************************************************'); 
test  fadd; 

writeln (' ******************************************************' ) ; 
test  imult; 

writeln  ('  ******************************************************' ) ; 
test  fmult; 

writeln {'******************************************************'); 
test  shift; 

writeln {'******************************************************' ) ; 
test  specialO; 

writeln {'******************************************************'  )  ; 
test  speciall; 

writeln  ('  ******************************************************' )  ; 
test  special2; 

writeln  {'  ******************************************************'  )  ; 
test  special3; 

writeln (' ******************************************************' ) ; 
count  :=  count  +  1; 

until  (local_cont  <>  'y')  and  (local_cont  <>  'Y'); 
continuous  :=  local_cont; 
end; 

begin 

debug  false; 
continuous  :=  'n'; 
stop_on_error  'y'; 
no_error  :=  0; 

writeln ('FPU  Test  Monitor'); 

stop_processor; 

while  true  do 

begin 

write ('>');  readln (command) ; 
if  command  =  'help'  then 
begin 

writeln (' tmem  :  test  memory'); 

writeln (' tlog  :  test  xor/and/or/passR' ) ; 

writeln (' tiadd  :  test  integer  add/sub/rsub' ) ; 
writeln (' timult  :  test  integer  mult'); 
writeln (' tfadd  :  test  floating  point  add' ) ; 
writeln (' tfmult  :  test  floating  point  mult'); 
writeln ('tshift  :  test  ROR/ROL/SHR/SHL' ) ; 
writeln (' tspecO  :  test  pack  exp  6  float  '); 

writeln (' tspecl  :  test  seed,  unp_exp,  unp_man,  root_exp,  &  root_man' ) ; 
writeln {' tspec2  :  test  round  &  trunc' ) ; 
writeln (' tspec3  :  test  sign  manipulation'); 
writeln (' tall  :  test  all  of  the  above'); 
writeln (' dsoe  :  do  not  stop  on  error'); 
writeln ('soe  :  stop  on  error'); 
writeln (' start  :  start  testing'); 
writeln (' stop  :  stop  testing'); 
writeln ('sb  :  select  memory  bank'); 

writeln ('dw  :  display  memory  word'); 

writeln ('sw  :  substitute  memory  word'); 

writeln  (' cont  :  set  testing  mode  to  continuous'); 

writeln {' single  :  set  testing  mode  to  single'); 

writeln (' debug  :  toggle  debug  setting'); 
writeln (' quit  :  quit  FPU  Test  Monitor'); 
end 
else 

if  command  =  'tmem'  then  test_memory 
else 

if  command  =  'tlog'  then  test_logical 
else 

if  command  =  'tiadd'  then  test_iadd 
else 

if  command  =  'tfadd'  then  test_fadd 
else 
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if  command  =  'timult'  then  test_imult 
else 

if  command  -  'tfmult'  then  test__fmult 
else 

if  command  =  'tshift'  then  test_shift 
else 

if  command  =  'tspecO'  then  test_specialO 
else 

if  command  -  'tspecl'  then  test_speciall 
else 

if  command  =  'tspec2'  then  test_special2 
else 

if  command  *  'tspec3'  then  test_specia!3 
else 

if  command  =  'tali'  then  test_all 
else 

if  command  =  'dsoe'  then  stop_on_error  :=  'n' 
else 

if  command  -  'soe'  then  stop_on_error  'y' 
else 

if  command  =  'start'  then  start_processor 
else 

if  command  *  'stop'  then  stop_processor 
else 

if  command  =  'sw'  then  substitute_word 
else 

if  command  =  'dw'  then  display_word 
else 

if  command  =  ' sb'  then  select_bank 
else 

if  command  =  't'  then  t 
else 

if  command  -  'debug'  then  toggle_debug 
else 

if  command  =  'quit'  then  exit 
else 

if  command  =  'cont'  then 
begin 

continuous  'y'; 

writeln ('Next  test  specified  will  be  repeated  indefinitely'); 
end 
else 

if  command  =  'single'  then 
begin 

continuous  :=  'n'; 

writeln (' Next  test  specified  will  not  be  repeated'); 
end 
else 

if  command  =  'exit'  then  exit 
end; 
end. 
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